home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / SSaver.bas < prev    next >
Encoding:
BASIC Source File  |  1999-05-31  |  7.1 KB  |  232 lines
  1. Attribute VB_Name = "SubMain"
  2. Option Explicit
  3.  
  4. Type RECT
  5.     Left As Long
  6.     Top As Long
  7.     Right As Long
  8.     Bottom As Long
  9. End Type
  10.  
  11. Public Const SWP_NOACTIVATE = &H10
  12. Public Const SWP_NOZORDER = &H4
  13. Public Const SWP_SHOWWINDOW = &H40
  14.  
  15. Public Const HWND_TOP = 0
  16.  
  17. Public Const WS_CHILD = &H40000000
  18. Public Const GWL_HWNDPARENT = (-8)
  19. Public Const GWL_STYLE = (-16)
  20.  
  21. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  22. Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  23. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  24. Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  25. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  26. Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  27. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  28.  
  29. ' Global variables.
  30. Public Const rmConfigure = 1
  31. Public Const rmScreenSaver = 2
  32. Public Const rmPreview = 3
  33. Public RunMode As Integer
  34.  
  35. Public Type Ball
  36.     BallClr As Long
  37.     BallR As Single
  38.     BallX As Single
  39.     BallY As Single
  40.     BallVx As Single
  41.     BallVy As Single
  42. End Type
  43.  
  44. Public NumBalls As Integer
  45. Public Balls() As Ball
  46.  
  47. ' Private variables.
  48. Private Const APP_NAME = "BouncingBalls"
  49.  
  50. ' See if another instance of the program is
  51. ' running in screen saver mode.
  52. Private Sub CheckShouldRun()
  53.     ' If no instance is running, we're safe.
  54.     If Not App.PrevInstance Then Exit Sub
  55.  
  56.     ' See if there is a screen saver mode instance.
  57.     If FindWindow(vbNullString, APP_NAME) Then End
  58.  
  59.     ' Set our caption so other instances can find
  60.     ' us in the previous line.
  61.     frmCover.Caption = APP_NAME
  62. End Sub
  63.  
  64. ' Load configuration information from the registry.
  65. Public Sub LoadConfig()
  66.     NumBalls = CInt(GetSetting(APP_NAME, _
  67.         "Settings", "NumBalls", "1"))
  68. End Sub
  69.  
  70. ' Initialize the balls.
  71. Public Sub InitializeBalls()
  72. Const MIN_CLR = 1
  73. Const MAX_CLR = 15
  74. Const MIN_BALLR = 0.03  ' Fraction of screen width.
  75. Const MAX_BALLR = 0.05
  76. Const MIN_VX = 0.005    ' Fraction of screen width.
  77. Const MAX_VX = 0.025
  78. Const MIN_VY = 0.005
  79. Const MAX_VY = 0.025
  80.  
  81. Dim i As Integer
  82. Dim wid As Single
  83. Dim hgt As Single
  84. Dim minx As Single
  85. Dim maxx As Single
  86. Dim miny As Single
  87. Dim maxy As Single
  88. Dim minr As Single
  89. Dim maxr As Single
  90. Dim minvx As Single
  91. Dim maxvx As Single
  92. Dim minvy As Single
  93. Dim maxvy As Single
  94.  
  95.     ' Initialize the ball information.
  96.     If NumBalls <= 0 Then
  97.         ' Erase the Balls array.
  98.         Erase Balls
  99.     Else
  100.         ' Allocate the Balls array.
  101.         ReDim Balls(1 To NumBalls)
  102.  
  103.         ' Pick random ball positions, sizes, and speeds.
  104.         wid = frmCover.ScaleWidth
  105.         hgt = frmCover.ScaleHeight
  106.         minr = MIN_BALLR * wid
  107.         maxr = MAX_BALLR * wid
  108.         minvx = MIN_VX * wid
  109.         maxvx = MAX_VX * wid
  110.         minvy = MIN_VY * wid
  111.         maxvy = MAX_VY * wid
  112.         Randomize
  113.         For i = 1 To NumBalls
  114.             With Balls(i)
  115.                 .BallClr = QBColor(Int((MAX_CLR - MIN_CLR + 1) * Rnd + MIN_CLR))
  116.                 .BallR = Int((maxr - minr + 1) * Rnd + minr)
  117.                 minx = .BallR
  118.                 maxx = wid - .BallR
  119.                 miny = .BallR
  120.                 maxy = hgt - .BallR
  121.                 .BallX = Int((maxx - minx + 1) * Rnd + minx)
  122.                 .BallY = Int((maxy - miny + 1) * Rnd + miny)
  123.                 .BallVx = Int((maxvx - minvx + 1) * Rnd + minvx)
  124.                 .BallVy = Int((maxvy - minvy + 1) * Rnd + minvy)
  125.                 If Int(2 * Rnd) = 1 Then .BallVx = -.BallVx
  126.                 If Int(2 * Rnd) = 1 Then .BallVy = -.BallVy
  127.             End With
  128.         Next i
  129.     End If
  130.  
  131.     frmCover.tmrMoveBalls.Enabled = (NumBalls > 0)
  132. End Sub
  133.  
  134.  
  135. ' Save configuration information in the registry.
  136. Public Sub SaveConfig()
  137.     SaveSetting APP_NAME, _
  138.         "Settings", "NumBalls", Format$(NumBalls)
  139. End Sub
  140.  
  141. ' Start the program.
  142. Public Sub Main()
  143. Dim args As String
  144. Dim preview_hwnd As Long
  145. Dim preview_rect As RECT
  146. Dim window_style As Long
  147.  
  148.     ' Get the command line arguments.
  149.     args = LCase$(Trim$(Command$))
  150.  
  151.     ' Examine the first 2 characters.
  152.     Select Case Left$(args, 2)
  153.         Case "/c"       ' Display configuration dialog.
  154.             RunMode = rmConfigure
  155.         Case "", "/s"   ' Run as a screen saver.
  156.             RunMode = rmScreenSaver
  157.         Case "/p"       ' Run in preview mode.
  158.             RunMode = rmPreview
  159.         Case Else       ' This shouldn't happen.
  160.             RunMode = rmScreenSaver
  161.     End Select
  162.  
  163.     Select Case RunMode
  164.         Case rmConfigure    ' Display configuration dialog.
  165.             frmConfig.Show
  166.         
  167.         Case rmScreenSaver  ' Run as a screen saver.
  168.             ' Make sure there isn't another one running.
  169.             CheckShouldRun
  170.  
  171.             ' Display the cover form.
  172.             frmCover.Show
  173.             ShowCursor False
  174.  
  175.         Case rmPreview      ' Run in preview mode.
  176.             ' Set the caption for Windows 95.
  177.             Load frmCover
  178.             frmCover.Caption = "Preview"
  179.  
  180.             ' Get the current window style.
  181.             window_style = GetWindowLong(frmCover.hwnd, GWL_STYLE)
  182.  
  183.             ' Add WS_CHILD to make this a child window.
  184.             window_style = (window_style Or WS_CHILD)
  185.  
  186.             ' Set the window's new style.
  187.             SetWindowLong frmCover.hwnd, _
  188.                 GWL_STYLE, window_style
  189.  
  190.             ' Get the preview area hWnd.
  191.             preview_hwnd = GetHwndFromCommand(args)
  192.  
  193.             ' Set the window's parent so it appears
  194.             ' inside the preview area.
  195.             SetParent frmCover.hwnd, preview_hwnd
  196.  
  197.             ' Save the preview area's hWnd in
  198.             ' the form's window structure.
  199.             SetWindowLong frmCover.hwnd, _
  200.                 GWL_HWNDPARENT, preview_hwnd
  201.  
  202.             ' Get the dimensions of the preview area.
  203.             GetClientRect preview_hwnd, preview_rect
  204.  
  205.             ' Show the preview.
  206.             SetWindowPos frmCover.hwnd, _
  207.                 HWND_TOP, 0&, 0&, _
  208.                 preview_rect.Right, _
  209.                 preview_rect.Bottom, _
  210.                 SWP_NOZORDER Or SWP_NOACTIVATE Or _
  211.                     SWP_SHOWWINDOW
  212.     End Select
  213. End Sub
  214. ' Get the hWnd for the preview window from the
  215. ' command line arguments.
  216. Private Function GetHwndFromCommand(ByVal args As String) As Long
  217. Dim argslen As Integer
  218. Dim i As Integer
  219. Dim ch As String
  220.  
  221.     ' Take the rightmost numeric characters.
  222.     args = Trim$(args)
  223.     argslen = Len(args)
  224.     For i = argslen To 1 Step -1
  225.         ch = Mid$(args, i, 1)
  226.         If ch < "0" Or ch > "9" Then Exit For
  227.     Next i
  228.  
  229.     GetHwndFromCommand = CLng(Mid$(args, i + 1))
  230. End Function
  231.  
  232.